home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.09 Sep 87 / fortran source / misc stuff / MacXRF Folder / macxrf.for < prev    next >
Encoding:
Text File  |  1985-11-01  |  63.3 KB  |  2,083 lines  |  [TEXT/EDIT]
  1. *************************************************************************
  2. * Title:  FORTRAN Subprogram Cross-Referencer - Main Program.
  3. *
  4. * Produced by: Absoft South, Inc.        Date:  1/14/85
  5. *
  6. * Purpose: To traverse a FORTRAN source file (program or subroutine)
  7. *            and define the subprograms that were called.  This process
  8. *            continues until the entire calling structure of the source
  9. *            is determined.
  10. *
  11. *       Traversing source code may involve calls to internal
  12. *         subroutines and functions.  If the user chooses to process
  13. *         internal routines, the routines are made external by
  14. *         appending ".ISR" to the routine's name.  As a byproduct
  15. *         of this operation, a large source file that contains several
  16. *         internal routines can be divided into its individual
  17. *         subroutines and functions.  This conversion of internal
  18. *         routines to external can be disabled if it is not deemed
  19. *         necessary by the user (see Internal Routines).
  20. *
  21. * Notes:   There are several flags that must be set during the initial
  22. *         phase of the cross-referencer.  They are set by answering
  23. *         a number of questions.  Regardless of the answers to any
  24. *         of the following questions, the source files involved will
  25. *         not be changed in any way.
  26. *
  27. *
  28. *                User Inquiry
  29. *                ---- -------
  30. *       First, the cross-referencer must know what source code needs to
  31. *         be traversed.  The main source must be saved in a file that
  32. *         shares the program's name (only the first 6 characters are
  33. *         significant).  Also, this file must have a ".FOR" extension.
  34. *         The main source file is defined with SFGETFILE.
  35. *
  36. *       The next pertains to the main output of the cross-referencer.
  37. *         As the routine is traversed, the names of all called routines
  38. *         are displayed on the screen in an indented format to denote
  39. *         their nesting level.  This screen output can be saved on
  40. *         disk by answering "T" to the following question:
  41. *
  42. *        Save the nesting level structure on disk(T/F)?_
  43. *
  44. *         Default = TRUE
  45. *         Produces <filename>.LVL
  46. *
  47. *      While a routine is being traversed, an internal symbol table is
  48. *        maitained.  This table of called programs can be saved on disk
  49. *        by answering "T" to the following question:
  50. *
  51. *        Save the symbol table on disk(T/F)?_
  52. *
  53. *         Default = TRUE
  54. *         Produces <filename>.SMB
  55. *
  56. *      One commonly asked question is "Who calls this thing?".  The
  57. *        cross-referencer will supply this information by answering
  58. *        "T" to the following question:
  59. *
  60. *        Save the reference table on disk(T/F)?_
  61. *
  62. *         Default = TRUE
  63. *         Produces <filename>.REF
  64. *
  65. *       The internal symbol table can be used to shorten the time it
  66. *         takes to complete the cross-reference process.  This is
  67. *         accomplished by eliminating redundant routine traversals.
  68. *         The nesting level file will flag those redundant calls with
  69. *         an "*".  This means that by inspecting earlier calls, the
  70. *         full traversal can be realized.
  71. *
  72. *        Use symbol table(T/F)?_
  73. *
  74. *         Default = FALSE
  75. *
  76. *       Conversion of internal subroutines and functions to an external
  77. *         form is essential to achieving a complete traversal of all
  78. *         calls pertaining to the main routine in question.  It may be
  79. *         advantageous to disable this feature though.  Not processing
  80. *         internal routines reduces traversal time and eliminates the
  81. *         need for adequate disk space to hold a copy of all internals.
  82. *         By answering "T" to the following question, the internal
  83. *         routines will be converted to external, and the traversal
  84. *         will be as complete as possible.
  85. *
  86. *        Convert internal routines to external(T/F)?_
  87. *
  88. *         Default = TRUE
  89. *
  90. *
  91. *                Nesting Structure
  92. *                ------- ---------
  93. *       There are 3 types of output from the cross-referencer:
  94. *
  95. *        1) Nesting level structure file (filename.LVL)
  96. *        2) Symbol table file (filename.SMB)
  97. *        3) Internal routines converted to external (subname.ISR)
  98. *
  99. *       You can produce all (assuming you have the disk space), some, or
  100. *         none of these files depending on the answers to the questions.
  101. *
  102. *       The ".LVL" file will produce the following output:
  103. *
  104. *        F    Called Programs
  105. *        -    ---------------
  106. *        F    TEST
  107. *        F    |   TFOR
  108. *        ?    |   |   TXXX
  109. *        M    |   |   TM68
  110. *        F    |   TFOR
  111. *        ?    |   |   TXXX
  112. *        M    |   |   TM68
  113. *        I    |   INTERN
  114. *        -- End of:  TEST.FOR
  115. *        Total size of all object files used is  302 bytes
  116. *
  117. *        The "F" column indicates the file type of the called routine.
  118. *          The possible file types are:
  119. *
  120. *        F - Fortran (".FOR")
  121. *        M - Assembly language (".M68")
  122. *        I - Internal routine (".ISR")
  123. *        ? - Source file not found (".???")
  124. *
  125. *       If the internal symbol table is used to speed up the traversal
  126. *         process, the new ".LVL" file would appear as follows:
  127. *
  128. *        A F    Called Programs
  129. *        - -    ---------------
  130. *          F    TEST
  131. *          F    |   TFOR
  132. *          ?    |   |   TXXX
  133. *          M    |   |   TM68
  134. *        * F    |   TFOR
  135. *          I    |   INTERN
  136. *        -- End of:  TEST.FOR
  137. *        Total size of all object files used is  302 bytes
  138. *
  139. *       The "A" column flags those files that have already been accessed
  140. *         and indicate that some of the calling structure is missing.
  141. *
  142. *
  143. *                Symbol Table
  144. *                ------ -----
  145. *       The ".SMB" file may also take on 2 different forms, depending
  146. *         on whether the symbol table is utilized during the traversal.
  147. *         In the case where the symbol table is not used, the output
  148. *         would appear as follows:
  149. *
  150. *           File      Size of     Number
  151. *           Name    Object Code  of Calls
  152. *           ----    -----------  --------
  153. *        INTERN.ISR        0          1
  154. *          TEST.FOR      192          1
  155. *          TFOR.FOR       48          2
  156. *          TM68.M68       62          2
  157. *          TXXX.???        0          2
  158. *        ==============================
  159. *        Totals----      302          8
  160. *              A total of  5 files.
  161. *
  162. *       If the symbol table is utilized during the traversal, it would be
  163. *         very difficult to maintain an accurate count of the number of
  164. *         times a routine was called.  Therefore, this column is omitted
  165. *         when the symbol table is used.
  166. *
  167. *       Also, the object code size for both INTERN.ISR and TXXX.??? are
  168. *         0.  The size of INTERN.ISR is accounted for by TEST.FOR.  The
  169. *         object to TXXX.??? was not found, so it is considered undefined.
  170. *
  171. *                Internal Routines
  172. *                -------- --------
  173. *       Files with the extension of ".ISR" are, as mentioned above,
  174. *         internal routines that has been made external.  The number of
  175. *         these is dependent on the source code being traversed.
  176. *
  177. * Warnings/Limitations:
  178. *       This program requires version 2.1 of the MacFortran toolbx.
  179. *
  180. *       When entering the main routine name, the extension will
  181. *         always be assumed ".FOR".  Any other extension is ignored.
  182. *
  183. *       Since the variable declarations are ignored by this program,
  184. *         it is impossible to distinguish a function call from an
  185. *         array assignment.  Therefore, the cross-referencer does not
  186. *         recognize the use of any function and will not reflect a
  187. *         function call in either the ".LVL", ".SMB", or ".REF" files.
  188. *
  189. *          There is a nesting limitation of 15 levels in this utility.
  190. *            If your program contains more than 15 nested calls, then
  191. *            simply find all occurrences of the number 15 in this file
  192. *            and replace it with the desired nesting depth.
  193. *
  194. *          There is a limit on the total number of subprograms that can
  195. *            be saved in the symbol table.  This limit of 375 files can
  196. *            be alterred by replacing every occurrence of 375 with the
  197. *            desired symbol table length.
  198. *          
  199. * Variables referenced in MACXRF.COM:
  200. *    OUTPUTLVL    - Save calling structure flag.        (Logical*4)
  201. *    OUTPUTSMB    - Save symbol table flag.            (Logical*4)
  202. *    OUTPUTREF    - Save reference table flag.        (Logical*4)
  203. *    SYMFLG       - Utilize symbol table flag.        (Logical*4)
  204. *    ISRFLG       - Convert internal routines to external.    (Logical*4)
  205. *    MAINPR       - Main program name.            (Char*6)
  206. *    PROGNM       - Active program name.            (Char*6)
  207. *    EXTN         - Active program extension.        (Char*4)
  208. *    FILTYP       - File extension type (I, F, M, or ?).    (Char*1)
  209. *    LVLNUM       - Current nesting level value.        (Integer*4)
  210. *    CURRENTUNIT  - Current input file unit number.        (Integer*4)
  211. *    SYMIDX         - Array of indices to the symbol table.    (Integer*4)
  212. *    SYMFIL       - Array of filenames in the symbol table.    (Char*6)
  213. *    SYMEXT       - Array of extensions for SYMFIL.        (Char*4)
  214. *    SYMCLL       - Array of call counters for SYMFIL.    (Integer*4)
  215. *    TOTALSYMBOLS - Number of files in the symbol table.    (Integer*4)
  216. *    NESTHEADER   - Illustrates the routine nesting level.    (Char*62)
  217. *    RECURSIVE    - Indicates the current call is recursive.    (Logical*4)
  218. *
  219. * Modification History:  
  220. *
  221. *************************************************************************
  222.       PROGRAM MACXRF
  223.       IMPLICIT NONE
  224. ****************************************************************************
  225. *
  226. * Local Variable and Function Declaration
  227. *
  228. ****************************************************************************
  229. * The size of individual object files.
  230.       INTEGER FILESIZE
  231.  
  232. * Summed total of all known object files in the calling structure.
  233.       INTEGER TOTALSIZE
  234.  
  235. * The total number of subroutine calls in the structure.
  236.       INTEGER TOTALCALLS
  237.  
  238. * Temporary counter variable for reference table output.
  239.       INTEGER REFCTR
  240.  
  241. * Temporary storage for the symbol table index.
  242.       INTEGER TMPSMBIDX
  243.  
  244. * Temporary storage for the reference table.
  245.       INTEGER TMPREFIDX
  246.  
  247. * Temporary string used in reference table output.
  248.       CHARACTER*11 TMPSTR
  249.  
  250. * Index/Counter variable.
  251.       INTEGER ICNT
  252.       INTEGER JCNT
  253.  
  254. * Indicates that a file has been located.
  255.       LOGICAL FOUND
  256.  
  257. * Error value for return from ROM routines.
  258.       INTEGER OSERR
  259.  
  260. * Function to strip the leading blanks and tabs from a string.
  261.       CHARACTER*132 BYPASS
  262.  
  263. ****************************************************************************
  264. *
  265. * File Parameter Block Definition
  266. *
  267. ****************************************************************************
  268.       INCLUDE PARAMS.INC
  269.  
  270. ****************************************************************************
  271. *
  272. * Macintosh ROM Trap Definition
  273. *
  274. ****************************************************************************
  275.       INCLUDE TOOLBX.PAR
  276.       INTEGER TOOLBX
  277.  
  278. ****************************************************************************
  279. *
  280. * Constant Definition
  281. *
  282. ****************************************************************************
  283.       INCLUDE MACXRF.PAR
  284.  
  285. ****************************************************************************
  286. *
  287. * Common Storage Definition
  288. *
  289. ****************************************************************************
  290.       INCLUDE MACXRF.COM
  291.  
  292. ****************************************************************************
  293. *
  294. * Executable Code
  295. *
  296. ****************************************************************************
  297.  
  298. ****************************************************************************
  299. *
  300. * Initialize and set defaults
  301. *
  302. ****************************************************************************
  303. * The initial program logical I/O unit starts with MAIN.
  304.       CURRENTUNIT=MAIN
  305.  
  306. * Subprogram call nesting level to 0.
  307.       LVLNUM=0
  308.  
  309. * The symbol table is empty.
  310.       TOTALSYMBOLS=0
  311.  
  312. * The total program size is 0.
  313.       TOTALSIZE=0
  314.  
  315. * There have been no calls made.
  316.       TOTALCALLS=0
  317.  
  318. * There will be a nesting level file produced.
  319.       OUTPUTLVL=.TRUE.
  320.  
  321. * There will be a symbol table file produced.
  322.       OUTPUTSMB=.TRUE.
  323.  
  324. * There will be a reference table file produced.
  325.       OUTPUTREF=.TRUE.
  326.  
  327. * The symbol table will not be utilized.
  328.       SYMFLG=.FALSE.
  329.  
  330. * The internal subprograms are to be included in the traversal.
  331.       ISRFLG=.TRUE.
  332.  
  333. * The first level routine is not considered recursive.
  334.       RECURSIVE=.FALSE.
  335.  
  336. * The initial file extension and type must always be one of a FORTRAN file.
  337.       EXTN='.FOR'
  338.       FILTYP='F'
  339.  
  340. * Initialize the call nesting level value.
  341.       NESTHEADER='    |   |   |   |   |   |   |   |   |   |   |   |'//
  342.      +         '|   |   |   '
  343.  
  344. * Initialize the subroutine reference list.
  345.       DO (ICNT=1,375)
  346.     DO (JCNT=1,40)
  347.       REFTBL(ICNT,JCNT)=0
  348.     REPEAT
  349.       REPEAT
  350.  
  351. * Initialize the file parameter block.
  352.       DO (ICNT=1,80)
  353.         params(ICNT) = 0
  354.       REPEAT
  355.  
  356. * and the pointer to the file name.
  357.       ionameptr = TOOLBX (PTR,TMPSTR)
  358.  
  359. ****************************************************************************
  360. *
  361. * Get necessary information from the user.
  362. *
  363. ****************************************************************************
  364.       CALL QRYUSR
  365.  
  366. ****************************************************************************
  367. *
  368. * See if the main program is anywhere to be found.
  369. *
  370. ****************************************************************************
  371.       INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
  372.       IF (.NOT. FOUND) THEN
  373.     WRITE (CONSOLE,*) 'Invalid file specification:',
  374.      +                    TRIM(PROGNM)//EXTN
  375.     STOP
  376.       ENDIF
  377.  
  378. ****************************************************************************
  379. *
  380. * Prepare the files as requested by the user.
  381. *
  382. ****************************************************************************
  383. * If a calling structure file is requested...
  384.       IF (OUTPUTLVL) THEN
  385. * ...then, open it.
  386.         OPEN (UNIT=LEVEL,FILE=TRIM(PROGNM)//'.LVL',STATUS='NEW'
  387.      +       ,ACCESS='SEQUENTIAL')
  388. * Initialize the file parameter block.
  389.     TMPSTR = CHAR(LEN(TRIM(PROGNM))+4)//TRIM(PROGNM)//'.LVL'
  390.     OSERR = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
  391.     fdtype = 'TEXT'
  392.     fdcreator = 'EDIT'
  393.     OSERR = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))
  394.       ENDIF
  395. * Write the header.
  396.       CALL LVLHDR
  397.  
  398. * If a symbol table file is requested, then...
  399.       IF (OUTPUTSMB) THEN
  400. * ...then, open it...
  401.         OPEN (UNIT=SYMBOL,FILE=TRIM(PROGNM)//'.SMB',STATUS='NEW'
  402.      +       ,ACCESS='SEQUENTIAL')
  403. * Initialize the file parameter block.
  404.     TMPSTR = CHAR(LEN(TRIM(PROGNM))+4)//TRIM(PROGNM)//'.SMB'
  405.     OSERR = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
  406.     fdtype = 'TEXT'
  407.     fdcreator = 'EDIT'
  408.     OSERR = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))
  409. * ...and write the header.
  410.     CALL SMBHDR
  411.       ENDIF
  412.  
  413. * If a reference table file is requested, then...
  414.       IF (OUTPUTREF) THEN
  415. * ...then, open it...
  416.         OPEN (UNIT=REFERENCE,FILE=TRIM(PROGNM)//'.REF',STATUS='NEW'
  417.      +       ,ACCESS='SEQUENTIAL')
  418. * Initialize the file parameter block.
  419.     TMPSTR = CHAR(LEN(TRIM(PROGNM))+4)//TRIM(PROGNM)//'.REF'
  420.     OSERR = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
  421.     fdtype = 'TEXT'
  422.     fdcreator = 'EDIT'
  423.     OSERR = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))
  424. * ...and write the header.
  425.     CALL REFHDR
  426.       ENDIF
  427.  
  428. ****************************************************************************
  429. *
  430. * Save the main file name for later and add it to the symbol table.
  431. *
  432. ****************************************************************************
  433.       MAINPR = PROGNM
  434.       CALL ADDSYM
  435.  
  436. ****************************************************************************
  437. *
  438. * Display the main program name.
  439. *
  440. ****************************************************************************
  441.       CALL DOLINE
  442.  
  443. ****************************************************************************
  444. *
  445. * Main line processing loop.
  446. *
  447. ****************************************************************************
  448.       CALL DOCALL
  449.  
  450. ****************************************************************************
  451. *
  452. * Build the requested reports from the information gathered.
  453. *
  454. ****************************************************************************
  455. * Sort the subroutine names and titles.
  456.       CALL SRTSYM
  457.  
  458. * Process the symbol and reference tables.
  459.       DO (ICNT=1,TOTALSYMBOLS)
  460.     TMPSMBIDX=SYMIDX(ICNT)
  461.     PROGNM=SYMFIL(TMPSMBIDX)
  462.     EXTN=SYMEXT(TMPSMBIDX)
  463.  
  464. * Determine the object code size.
  465.     IF ((EXTN = '.ISR') .OR. (EXTN = '.???')) THEN
  466.       FILESIZE = 0
  467.     ELSE
  468.       IF (PROGNM = MAINPR) THEN
  469.         INQUIRE (FILE=TRIM(PROGNM)//' APL',EXIST=FOUND,
  470.      +             SIZE=FILESIZE)
  471.         IF (.NOT. FOUND) THEN
  472.           INQUIRE (FILE=TRIM(PROGNM)//'.SUB',EXIST=FOUND,
  473.      +               SIZE=FILESIZE)
  474.         ENDIF
  475.       ELSE
  476.         INQUIRE (FILE=TRIM(PROGNM)//'.SUB',EXIST=FOUND,
  477.      +             SIZE=FILESIZE)
  478.       ENDIF
  479.     ENDIF
  480.  
  481.     IF (.NOT. FOUND) FILESIZE = 0
  482.  
  483. * Output the symbol table data of the current symbol.
  484.     IF (OUTPUTSMB) THEN
  485.       IF (SYMFLG) THEN
  486.         WRITE(SYMBOL,10) TRIM(PROGNM)//EXTN,FILESIZE
  487.       ELSE
  488.         WRITE(SYMBOL,20) TRIM(PROGNM)//EXTN,FILESIZE,
  489.      +                 SYMCLL(TMPSMBIDX)
  490.       ENDIF
  491.     ENDIF
  492.     TOTALSIZE=TOTALSIZE+FILESIZE
  493.     TOTALCALLS=TOTALCALLS+SYMCLL(TMPSMBIDX)
  494.  
  495. * Output the reference list of the current symbol.
  496.     IF (OUTPUTREF) THEN
  497.       TMPSMBIDX = SYMIDX(ICNT)
  498.  
  499. * Write the symbol name and ":".
  500.       PROGNM = SYMFIL(TMPSMBIDX)
  501.       EXTN = SYMEXT(TMPSMBIDX)
  502.       TMPSTR = TRIM(PROGNM)//EXTN//':'
  503.       TYPE (REFERENCE,30) BYPASS(TMPSTR)
  504.  
  505.       REFCTR = 0
  506.  
  507.       DO (JCNT=1,40)
  508.         TMPREFIDX = REFTBL(TMPSMBIDX,JCNT)
  509.         IF (TMPREFIDX = 0) THEN
  510.           IF (JCNT = 1) TYPE (REFERENCE,*) '  (Main Routine)'
  511.           EXIT
  512.         ENDIF
  513.         IF (REFCTR = 4) THEN
  514.           REFCTR = 0
  515.           WRITE (REFERENCE,*)
  516.           TYPE (REFERENCE,40)
  517.         ELSE
  518.           REFCTR = REFCTR + 1
  519.         ENDIF
  520.         PROGNM = SYMFIL(TMPREFIDX)
  521.         EXTN = SYMEXT(TMPREFIDX)
  522.         TYPE (REFERENCE,50) BYPASS(TRIM(PROGNM)//EXTN)
  523.       REPEAT
  524.  
  525. * Seperate each reference list with a blank line.
  526.       WRITE (REFERENCE,*)
  527.     ENDIF
  528.  
  529.       REPEAT
  530.  
  531. ****************************************************************************
  532. *
  533. * Terminate the process.
  534. *
  535. ****************************************************************************
  536.       IF (OUTPUTSMB) THEN
  537.  
  538.     IF (SYMFLG) THEN
  539.       WRITE(SYMBOL,*) '==================='
  540.       WRITE(SYMBOL,10) 'Totals----',TOTALSIZE
  541.     ELSE
  542.       WRITE(SYMBOL,*) '=============================='
  543.       WRITE(SYMBOL,20) 'Totals----',TOTALSIZE,TOTALCALLS
  544.     ENDIF
  545.     WRITE(SYMBOL,*) '      A total of ',TOTALSYMBOLS,' files.'
  546.     CLOSE(UNIT=SYMBOL)
  547.       ENDIF
  548.  
  549.       IF (OUTPUTREF) THEN
  550.     WRITE(REFERENCE,*)'--- End of: ',TRIM(MAINPR),'.FOR'
  551.     WRITE(REFERENCE,*) '      A total of ',TOTALSYMBOLS,' files.'
  552.     CLOSE(UNIT=REFERENCE)
  553.       ENDIF
  554.  
  555.       IF (OUTPUTLVL) THEN
  556.     WRITE(LEVEL,*)'--- End of: ',TRIM(MAINPR),'.FOR'
  557.     WRITE(LEVEL,*) 'Total size of all object files used is ',
  558.      +     TOTALSIZE,' bytes'
  559.     CLOSE(UNIT=LEVEL)
  560.       ENDIF
  561.  
  562.       WRITE(CONSOLE,*)'--- End of: ',TRIM(MAINPR),'.FOR'
  563.       WRITE(CONSOLE,*) 'Total size of all object files used is ',
  564.      +     TOTALSIZE,' bytes'
  565.  
  566. 10    FORMAT (A10,2X,I7)
  567. 20    FORMAT (A10,2X,I7,4X,I7)
  568. 30    FORMAT (A11)
  569. 40    FORMAT (12X)
  570. 50    FORMAT (2X,A10)
  571.  
  572.       END
  573.  
  574. *************************************************************************
  575. * Title: FORTRAN Subprogram Cross-Referencer - User interface
  576. *
  577. * Produced by: Absoft South, Inc.             Date: 1/15/85
  578. *
  579. * Purpose: Retrieve data from the user that will determine the way
  580. *         the given program is cross referenced.
  581. *            
  582. * Notes:   All input is converted to upper case before assigned to
  583. *         its associated variable.  With the exception of the
  584. *         file name, all of the variables have default values in
  585. *         case the user doesn't answer any of the questions.
  586. *         The defaults are:
  587. *
  588. *        OUTPUTLVL = .TRUE.
  589. *        OUTPUTSMB = .TRUE.
  590. *        OUTPUTREF = .TRUE.
  591. *        SYMFLG    = .FALSE.
  592. *        ISRFLG    = .TRUE.
  593. *    
  594. * Warnings/Limitations:  
  595. *      
  596. * Calling Conventions:  
  597. *    CALL QRYUSR
  598. *
  599. * Variables referenced in MACXRF.COM:
  600. *    OUTPUTLVL    - Save calling structure flag.        (Logical*4)
  601. *    OUTPUTSMB    - Save symbol table flag.            (Logical*4)
  602. *    OUTPUTREF    - Save reference table flag.        (Logical*4)
  603. *    SYMFLG       - Utilize symbol table flag.        (Logical*4)
  604. *    ISRFLG       - Convert internal routines to external.    (Logical*4)
  605. *    PROGNM       - Active program name.            (Char*6)
  606. *
  607. * Modification History:  
  608. *
  609. *************************************************************************
  610.       SUBROUTINE QRYUSR
  611.       IMPLICIT NONE
  612. ****************************************************************************
  613. *
  614. * Local Variable and Function Declaration
  615. *
  616. ****************************************************************************
  617.       INTEGER*1 REPLY(76)
  618.       INTEGER*2 GOOD
  619.       CHARACTER*4 OSTYPE
  620.       INTEGER*2 VRNUM
  621.       INTEGER*2 VERSION
  622.       CHARACTER*64 FNAME
  623.       INTEGER FLENGTH
  624.       CHARACTER*4 FTYPE
  625.  
  626.       EQUIVALENCE (REPLY(1), GOOD)
  627.       EQUIVALENCE (REPLY(3), OSTYPE)
  628.       EQUIVALENCE (REPLY(7), VRNUM)
  629.       EQUIVALENCE (REPLY(9), VERSION)
  630.       EQUIVALENCE (REPLY(11), FNAME)
  631.  
  632. * Position of the SFGETFILE box.
  633.       INTEGER*2 WHERE(2)
  634.  
  635. * String index to the "." in a file name.
  636.       INTEGER PRGIDX
  637.  
  638. * Temporary storage for the user input.
  639.       CHARACTER*1 INPCHR
  640.  
  641. * Function to convert a character string to all upper case.
  642.       CHARACTER*6 UCS
  643.  
  644. ****************************************************************************
  645. *
  646. * Macintosh ROM Trap Definition
  647. *
  648. ****************************************************************************
  649.       INCLUDE TOOLBX.PAR
  650.       INTEGER TOOLBX
  651.  
  652. ****************************************************************************
  653. *
  654. * Constant Definition
  655. *
  656. ****************************************************************************
  657.       INCLUDE MACXRF.PAR
  658.  
  659. ****************************************************************************
  660. *
  661. * Common Storage Definition
  662. *
  663. ****************************************************************************
  664.       INCLUDE MACXRF.COM
  665.  
  666. * Initialize the SFGETFILE box position coordinates.
  667.       DATA WHERE /50,50/
  668.  
  669. ****************************************************************************
  670. *
  671. * Executable Code
  672. *
  673. ****************************************************************************
  674. * Get the main program name from the user.
  675. C      TYPE (CONSOLE,*) 'Enter Main Program Filename:'
  676. C      READ (CONSOLE,*) PROGNM
  677.  
  678. * Define the type to be searched.
  679.       FTYPE = 'TEXT'
  680.  
  681. * Get the main program name from the user.
  682.       CALL TOOLBX (SFGETFILE,WHERE,0,0,1,TOOLBX(PTR,FTYPE),0,
  683.      +           REPLY,2)
  684.      
  685. * If not found...
  686.       IF (GOOD = 0) THEN
  687. * ...then, quit.
  688.     STOP
  689.       ELSE
  690. * ...otherwise, define the filename and continue.
  691.     FLENGTH = ICHAR(FNAME(1:1))
  692.     PROGNM = FNAME(2:FLENGTH+1)
  693.       ENDIF
  694.  
  695. * Make sure it is capitalized and has no extension.
  696.       PROGNM = UCS (PROGNM)
  697.       PRGIDX = INDEX(PROGNM,'.')
  698.       IF (PRGIDX > 0) PROGNM = PROGNM(1:(PRGIDX-1))
  699.  
  700. * See if the user wants to...
  701. * ...create a file to hold the call structure of the program.
  702.       TYPE (CONSOLE,*) 'Save the nesting level structure on disk(T/F)?'
  703.       READ (CONSOLE,*) INPCHR
  704.       IF (UCS(INPCHR) = 'F') OUTPUTLVL = .FALSE.
  705.  
  706. * ...create a file to hold a list of routines called.
  707.       TYPE (CONSOLE,*) 'Save the symbol table on disk(T/F)?'
  708.       READ (CONSOLE,*) INPCHR
  709.       IF (UCS(INPCHR) = 'F') OUTPUTSMB = .FALSE.
  710.  
  711. * ...create a file that lists all calling routines for a called file.
  712.       TYPE (CONSOLE,*) 'Save the reference table on disk(T/F)?'
  713.       READ (CONSOLE,*) INPCHR
  714.       IF (UCS(INPCHR) = 'F') OUTPUTREF = .FALSE.
  715.  
  716. * ...utilize the internal symbol table during the traversal.
  717.       TYPE (CONSOLE,*) 'Use symbol table(T/F)?'
  718.       READ (CONSOLE,*) INPCHR
  719.       IF (UCS(INPCHR) = 'T') SYMFLG = .TRUE.
  720.  
  721. * ...process internal subroutines.
  722.       TYPE (CONSOLE,*) 'Convert internal routines to external(T/F)?'
  723.       READ (CONSOLE,*) INPCHR
  724.       IF (UCS(INPCHR) = 'F') ISRFLG = .FALSE.
  725.  
  726. ****************************************************************************
  727. *
  728. * Initialize the window.
  729. *
  730. ****************************************************************************
  731.       TYPE(CONSOLE,10)
  732. 10    FORMAT(XY(-1,0))
  733.  
  734.       RETURN
  735.       END
  736.  
  737. *************************************************************************
  738. * Title: FORTRAN Subprogram Cross-Referencer - Call Statement Processor
  739. *
  740. * Produced by: Absoft South, Inc.             Date:  1/15/85
  741. *
  742. * Purpose: To perform all processes on all called subroutines and
  743. *         functions.  The processes include calling the symbol
  744. *         table handler, maintaining the program stack, and testing
  745. *         for recursive calls.
  746. *            
  747. * Notes:   If necessary, the file is tested for internal routines.  This
  748. *         search is not done if ISRFLG is false, or the active file
  749. *         has the ".ISR" extension (these files will never contain
  750. *         internal routines).
  751. *
  752. *       Every line of the source (excluding comments and blank lines) is
  753. *         tested for a call.  If one is found, the symbol table and other
  754. *         variables are updated.  Then this procedure calls itself and
  755. *         process continues.  As files terminate, the recursion unwinds
  756. *         itself until the main routine is closed.
  757. *    
  758. * Warnings/Limitations: 
  759. *      
  760. * Calling Conventions: 
  761. *    CALL DOCALL
  762. *
  763. * Variables referenced in MACXRF.COM:
  764. *    SYMFLG       - Utilize symbol table flag.        (Logical*4)
  765. *    ISRFLG       - Convert internal routines to external.    (Logical*4)
  766. *    INLINE       - A single source code line.        (Char*132)
  767. *    PROGNM       - Active program name.            (Char*6)
  768. *    EXTN         - Active program extension.        (Char*4)
  769. *    PRSTCK       - Program name nesting stack.        (Char*6)
  770. *    LVLNUM       - Current nesting level value.        (Integer*4)
  771. *    CURRENTUNIT  - Current input file unit number.        (Integer*4)
  772. *    ISSYMBOL     - Denotes PROGNM is in the symbol table.    (Integer*4)
  773. *    RECURSIVE    - Indicates the current call is recursive.    (Logical*4)
  774. *
  775. * Modification History:
  776. *
  777. *************************************************************************
  778.       SUBROUTINE DOCALL
  779.       IMPLICIT NONE
  780. ****************************************************************************
  781. *
  782. * Local Variable and Function Declaration
  783. *
  784. ****************************************************************************
  785. * Temporary storage for the result of ISCALL.
  786.       LOGICAL CLLFLG
  787.  
  788. * Index/Counter variable.
  789.       INTEGER ICNT
  790.  
  791. * Function to convert a character string to all upper case.
  792.       CHARACTER*132 UCS
  793.  
  794. * Function to strip the leading blanks and tabs from a string.
  795.       CHARACTER*132 BYPASS
  796.  
  797. * Call statement recognition function (logical*4).
  798.       LOGICAL ISCALL
  799.  
  800. * Function to indicate that the given string is a FORTRAN end statement.
  801.       LOGICAL ENDONLY
  802.  
  803. ****************************************************************************
  804. *
  805. * Constant Definition
  806. *
  807. ****************************************************************************
  808.       INCLUDE MACXRF.PAR
  809.  
  810. ****************************************************************************
  811. *
  812. * Global data common block.
  813. *
  814. ****************************************************************************
  815.       INCLUDE MACXRF.COM
  816.  
  817. ****************************************************************************
  818. *
  819. * Executable Code
  820. *
  821. ****************************************************************************
  822. * Initialize the nesting level specific variables.
  823.       CURRENTUNIT=MAIN+LVLNUM
  824.       LVLNUM=LVLNUM+1
  825.       PRSTCK(LVLNUM)=PROGNM
  826.  
  827. * Open the currently active file.
  828.       OPEN (UNIT=CURRENTUNIT,FILE=TRIM(PROGNM)//EXTN,STATUS='OLD')
  829.  
  830. * If internal routines are to be made external and this is not ".ISR".
  831.       IF ((ISRFLG) .AND.
  832.      +    (EXTN<>'.ISR')) THEN
  833.     CALL FNDISR
  834.       ENDIF
  835.  
  836. * Process each source line until the routine has been cross-referenced.
  837.       DO
  838.     READ (CURRENTUNIT,30) INLINE
  839.  
  840. * If the line is not a comment or blank, process it.
  841.     IF (.NOT. ((INLINE(1:1) = 'C') .OR.
  842.      +             (INLINE(1:1) = '*') .OR.
  843.      +             (INLINE(1:1) = '!') .OR.
  844.      +             (INLINE      = ' '))) THEN
  845.  
  846.       INLINE = UCS (BYPASS(INLINE(7:)))
  847. * Search the source line for a subroutine call.
  848. *  Note that ISCALL sets PROGNM, EXTN, and FILTYP.
  849.       CLLFLG=ISCALL()
  850.       IF (CLLFLG) THEN
  851. * Check for a recursive call when the symbol table isn't utilized.
  852.         IF (.NOT. SYMFLG) THEN
  853.           DO (ICNT=1,LVLNUM)
  854.         IF (PRSTCK(ICNT)=PROGNM) THEN
  855.           RECURSIVE=.TRUE.
  856.           EXIT        
  857.         ENDIF
  858.           REPEAT
  859.         ENDIF
  860.  
  861. * Add the new file name to the symbol table.
  862.         CALL ADDSYM
  863.  
  864. * Add the symbol to the reference table.
  865.         IF (OUTPUTREF) CALL ADDREF
  866.  
  867. * Display the symbol name such that the nesting level is apparent.
  868.         CALL DOLINE
  869.  
  870. * If the call is recursive, don't do anything but reset the flag.
  871.         IF (RECURSIVE) THEN
  872.           RECURSIVE=.FALSE.
  873.         ELSE
  874.  
  875. * Otherwise, go process the call.
  876.           IF (((.NOT. SYMFLG) .OR.
  877.      +           (SYMFLG .AND. (.NOT. ISSYMBOL))) .AND.
  878.      +           ((FILTYP <> 'M') .AND. (FILTYP <> '?'))) CALL DOCALL
  879.         ENDIF
  880.       ELSE
  881.  
  882. * If the current line marks the end of the routine, then quit.
  883.         IF (ENDONLY(INLINE)) EXIT
  884.       ENDIF
  885.     ENDIF
  886.       REPEAT
  887.  
  888. * Close the currently active file.
  889.       CLOSE (UNIT=CURRENTUNIT)
  890.  
  891. * Reset the nesting level specific variables.
  892.       LVLNUM=LVLNUM-1
  893.       CURRENTUNIT=(MAIN+LVLNUM)-1
  894.  
  895. 30    FORMAT (A80)
  896.       RETURN
  897.       END
  898.  
  899. *************************************************************************
  900. * Title: FORTRAN Subprogram Cross-Referencer - Nesting level display
  901. *
  902. * Produced by: Absoft South, Inc.        Date:  1/15/85
  903. *
  904. * Purpose: To display the current subprogram's type (F, M, I, or ?) and
  905. *            its name, indented to represent the current nesting level.
  906. *            
  907. * Notes:   It is possible to write this information to a file.  The
  908. *         decision must be made in QRYUSR.
  909. *    
  910. * Warnings/Limitations:  
  911. *      
  912. * Calling Conventions:  
  913. *    CALL DOLINE
  914. *
  915. * Variables referenced in MACXRF.COM:
  916. *    OUTPUTLVL    - Save calling structure flag.        (Logical*4)
  917. *    SYMFLG       - Utilize symbol table flag.        (Logical*4)
  918. *    PROGNM       - Active program name.            (Char*6)
  919. *    FILTYP       - File extension type (I, F, M, or ?).    (Char*1)
  920. *    LVLNUM       - Current nesting level value.        (Integer*4)
  921. *    ISSYMBOL     - Denotes PROGNM is in the symbol table.    (Integer*4)
  922. *    NESTHEADER   - Illustrates the routine nesting level.    (Char*62)
  923. *    RECURSIVE    - Indicates the current call is recursive.    (Logical*4)
  924. *
  925. * Modification History:  
  926. *************************************************************************
  927.       SUBROUTINE DOLINE
  928.       IMPLICIT NONE
  929. ****************************************************************************
  930. *
  931. * Local Variable and Function Declaration
  932. *
  933. ****************************************************************************
  934. * Temporary storage for an output buffer.
  935.       CHARACTER*71 OUTBUF
  936.  
  937. ****************************************************************************
  938. *
  939. * Constant Definition
  940. *
  941. ****************************************************************************
  942.       INCLUDE MACXRF.PAR
  943.  
  944. ****************************************************************************
  945. *
  946. * Global data common block.
  947. *
  948. ****************************************************************************
  949.       INCLUDE MACXRF.COM
  950.  
  951. ****************************************************************************
  952. *
  953. * Executable Code
  954. *
  955. ****************************************************************************
  956. * Define the line to be output.
  957.       IF (SYMFLG) THEN
  958.     IF (ISSYMBOL) THEN
  959.       OUTBUF='* '//FILTYP//NESTHEADER(1:((LVLNUM+1)*4))//PROGNM
  960.     ELSE
  961.       OUTBUF='  '//FILTYP//NESTHEADER(1:((LVLNUM+1)*4))//PROGNM
  962.     ENDIF
  963.       ELSE
  964.         OUTBUF=FILTYP//NESTHEADER(1:((LVLNUM+1)*4))//PROGNM
  965.       ENDIF
  966.  
  967. * Mark the call as recursive if necessary.
  968.       IF (RECURSIVE) OUTBUF=TRIM(OUTBUF)//'(R)'
  969.  
  970. * Output the line.
  971.       WRITE (CONSOLE,*) TRIM(OUTBUF)
  972.       IF (OUTPUTLVL) THEN
  973.     WRITE (LEVEL,*) TRIM(OUTBUF)
  974.       ENDIF
  975.       RETURN
  976.       END
  977.  
  978. *************************************************************************
  979. * Title: FORTRAN Subprogram Cross-Referencer - Add Symbol Table Entry
  980. *
  981. * Produced by: Absoft South, Inc.             Date:  1/15/85
  982. *
  983. * Purpose: To make the string held in PROGNM a part of the symbol table,
  984. *         if it is not already there.
  985. *            
  986. * Notes:   This routine sets the value if ISSYMBOL to true if PROGNM is
  987. *         already part of the symbol table, and false if it was not.
  988. *    
  989. * Warnings/Limitations: 
  990. *      
  991. * Calling Conventions: 
  992. *    CALL ADDSYM
  993. *
  994. * Variables referenced in MACXRF.COM:
  995. *    PROGNM       - Active program name.            (Char*6)
  996. *    EXTN         - Active program extension.        (Char*4)
  997. *    SYMIDX         - Array of indices to the symbol table.    (Integer*4)
  998. *    SYMFIL       - Array of filenames in the symbol table.    (Char*6)
  999. *    SYMEXT       - Array of extensions for SYMFIL.        (Char*4)
  1000. *    SYMCLL       - Array of call counters for SYMFIL.    (Integer*4)
  1001. *    TOTALSYMBOLS - Number of files in the symbol table.    (Integer*4)
  1002. *    ISSYMBOL     - Denotes PROGNM is in the symbol table.    (Integer*4)
  1003. *
  1004. * Modification History:
  1005. *
  1006. *************************************************************************
  1007.       SUBROUTINE ADDSYM
  1008.       IMPLICIT NONE
  1009. ****************************************************************************
  1010. *
  1011. * Local Variable and Function Declarations
  1012. *
  1013. ****************************************************************************
  1014. * Index/Counter variable.
  1015.       INTEGER ICNT
  1016.  
  1017. * Integer function to determine the symbol table index of a routine name.
  1018.       INTEGER GETIDX
  1019.  
  1020. ****************************************************************************
  1021. *
  1022. * Global data common block.
  1023. *
  1024. ****************************************************************************
  1025.       INCLUDE MACXRF.COM
  1026.  
  1027. ****************************************************************************
  1028. *
  1029. * Executable Code
  1030. *
  1031. ****************************************************************************
  1032. * Search the symbol table for the string held in PROGNM.
  1033.       ICNT = GETIDX (PROGNM)
  1034.  
  1035. * If PROGNM is not in the symbol table...
  1036.       IF (ICNT = 0) THEN
  1037. * ...then, indicate this...
  1038.     ISSYMBOL=.FALSE.
  1039. * ...point at the next symbol table entry...
  1040.     TOTALSYMBOLS=TOTALSYMBOLS+1
  1041. * ...and define it.
  1042.     SYMIDX(TOTALSYMBOLS)=TOTALSYMBOLS
  1043.     SYMFIL(TOTALSYMBOLS)=PROGNM
  1044.     SYMEXT(TOTALSYMBOLS)=EXTN
  1045.     SYMCLL(TOTALSYMBOLS)=1
  1046.       ELSE
  1047. * Otherwise, indicate this globally...
  1048.     ISSYMBOL=.TRUE.
  1049. * ...and increment the call counter.
  1050.     SYMCLL(ICNT)=SYMCLL(ICNT)+1
  1051.       ENDIF
  1052.  
  1053.       RETURN
  1054.       END
  1055.  
  1056. *************************************************************************
  1057. * Title: FORTRAN Subprogram Cross-Referencer - Add Reference Table Entry
  1058. *
  1059. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1060. *
  1061. * Purpose: To add a calling reference to the reference list of a routine,
  1062. *         if the calling routine is not already part of the reference
  1063. *         list.
  1064. *            
  1065. * Notes:   The structure for the reference table is a list of up to 40
  1066. *         symbol table indices for each symbol table entry.
  1067. *    
  1068. * Warnings/Limitations: 
  1069. *       Any references by more than 40 seperate routines will be
  1070. *         truncated.
  1071. *      
  1072. * Calling Conventions: 
  1073. *       CALL ADDREF
  1074. *
  1075. * Variables referenced in MACXRF.COM:
  1076. *    PROGNM       - Active program name.            (Char*6)
  1077. *    EXTN         - Active program extension.        (Char*4)
  1078. *    SYMIDX         - Array of indices to the symbol table.    (Integer*4)
  1079. *    SYMFIL       - Array of filenames in the symbol table.    (Char*6)
  1080. *    SYMEXT       - Array of extensions for SYMFIL.        (Char*4)
  1081. *    REFTBL       - Table of calling routine references.    (Char*4)
  1082. *    TOTALSYMBOLS - Number of files in the symbol table.    (Integer*4)
  1083. *    ISSYMBOL     - Denotes PROGNM is in the symbol table.    (Integer*4)
  1084. *
  1085. * Modification History:
  1086. *
  1087. *************************************************************************
  1088.       SUBROUTINE ADDREF
  1089.       IMPLICIT NONE
  1090. ****************************************************************************
  1091. *
  1092. * Local Variable and Function Declarations
  1093. *
  1094. ****************************************************************************
  1095. * An index to be saved in the reference table.
  1096.       INTEGER REFIDX
  1097.  
  1098. * Index/Counter variable.
  1099.       INTEGER ICNT
  1100.       INTEGER JCNT
  1101.  
  1102. * Integer function to determine the symbol table index of a routine name.
  1103.       INTEGER GETIDX
  1104.  
  1105. ****************************************************************************
  1106. *
  1107. * Global data common block.
  1108. *
  1109. ****************************************************************************
  1110.       INCLUDE MACXRF.COM
  1111.  
  1112. ****************************************************************************
  1113. *
  1114. * Executable Code
  1115. *
  1116. ****************************************************************************
  1117. * Define the index of the called program.
  1118.       ICNT = GETIDX (PROGNM)
  1119.  
  1120. * See if this reference has been made before.
  1121.       DO (JCNT=1,40)
  1122.  
  1123. * If there are no more references in this list, then quit.
  1124.     IF (REFTBL(ICNT,JCNT) = 0) EXIT
  1125.  
  1126. * If this reference has alredy been made, then return.
  1127.     IF (PRSTCK(LVLNUM) = SYMFIL(REFTBL(ICNT,JCNT))) RETURN
  1128.       REPEAT
  1129.  
  1130. * Define the symbol table index of the calling program and save it.
  1131.       REFTBL(ICNT,JCNT) = GETIDX (PRSTCK(LVLNUM))
  1132.  
  1133.       RETURN
  1134.       END
  1135.  
  1136. *************************************************************************
  1137. * Title: FORTRAN Subprogram Cross-Referencer - Symbol table index search
  1138. *
  1139. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1140. *
  1141. * Purpose: To search through the current symbol table for an occurrence
  1142. *         of the given program name.
  1143. *            
  1144. * Notes:   This integer function returns the index of the given program
  1145. *         name, if it is found.  It returns 0 if no match is found.
  1146. *    
  1147. * Warnings/Limitations:
  1148. *       This routine will not function properly after the symbol
  1149. *         table has been sorted.
  1150. *      
  1151. * Calling Conventions: 
  1152. *       INDEX = GETIDX (FILNAM)
  1153. *
  1154. * Calling Parameters:  
  1155. *     Unmodified: FILNAM - The name of the symbol to be found.
  1156. *       Modified:   NONE
  1157. *     Returned:   NONE
  1158. *
  1159. * Variables referenced in MACXRF.COM:
  1160. *    SYMFIL       - Array of filenames in the symbol table.    (Char*6)
  1161. *    TOTALSYMBOLS - Number of files in the symbol table.    (Integer*4)
  1162. *
  1163. * Modification History:
  1164. *
  1165. *************************************************************************
  1166.       INTEGER FUNCTION GETIDX (FILNAM)
  1167.       IMPLICIT NONE
  1168. ****************************************************************************
  1169. *
  1170. * Local Variable and Function Declarations
  1171. *
  1172. ****************************************************************************
  1173. * The name of the routine to be found.
  1174.       CHARACTER*6 FILNAM
  1175.  
  1176. * The table index of the of FILNAM.
  1177.       INTEGER TBLIDX
  1178.  
  1179. ****************************************************************************
  1180. *
  1181. * Global data common block.
  1182. *
  1183. ****************************************************************************
  1184.       INCLUDE MACXRF.COM
  1185.  
  1186. ****************************************************************************
  1187. *
  1188. * Executable Code
  1189. *
  1190. ****************************************************************************
  1191. * Check all of the symbol table entries.
  1192.       DO (TBLIDX=1,TOTALSYMBOLS)
  1193.  
  1194. * If a match is found, define the function value and quit.
  1195.     IF (SYMFIL(TBLIDX) = FILNAM) THEN
  1196.       GETIDX=TBLIDX
  1197.       RETURN
  1198.     ENDIF
  1199.       REPEAT
  1200.  
  1201. * If no match is found, set the function accordingly.
  1202.       GETIDX=0
  1203.       RETURN
  1204.       END
  1205.  
  1206. *************************************************************************
  1207. * Title: FORTRAN Subprogram Cross-Referencer - Symbol table sorter
  1208. *
  1209. * Produced by: Absoft South, Inc.             Date:  1/14/85
  1210. *
  1211. * Purpose: To simulataneously sort the 3 arrays that make up the symbol
  1212. *         table.  The 3 arrays are SYMFIL, SYMEXT, and SYMCLL.
  1213. *
  1214. * Notes:   The symbol table is sorted by implementing a level of
  1215. *         indirection through the use of SYMIDX.  This is a table
  1216. *         of indices that point to a symbol table entry.  Rather than
  1217. *         swapping the elements of 3 arrays, their indices are swapped
  1218. *         to achieve the same effect.
  1219. *
  1220. * Warnings/Limitations:  NONE
  1221. *      
  1222. * Calling Conventions:  
  1223. *           CALL SRTSYM
  1224. *
  1225. * Variables referenced in MACXRF.COM:
  1226. *    SYMIDX         - Array of indices to the symbol table.    (Integer*4)
  1227. *    SYMFIL       - Array of filenames in the symbol table.    (Char*6)
  1228. *    TOTALSYMBOLS - Number of files in the symbol table.    (Integer*4)
  1229. *
  1230. * Modification History:
  1231. *
  1232. *************************************************************************
  1233.       SUBROUTINE SRTSYM
  1234.       IMPLICIT NONE
  1235. ****************************************************************************
  1236. *
  1237. * Local Variable and Function Declarations
  1238. *
  1239. ****************************************************************************
  1240. * Temporary "current" and "next" symbol table indices.
  1241.       INTEGER CURIDX
  1242.       INTEGER NXTIDX
  1243.  
  1244. * An index to the next symbol table entry to be tested.
  1245.       INTEGER NEXT
  1246.  
  1247. * An index to the current symbol table entry to be tested.
  1248.       INTEGER CURRENT
  1249.  
  1250. * Intermediate symbol table length.
  1251.       INTEGER TABLELENGTH
  1252.  
  1253. ****************************************************************************
  1254. *
  1255. * Global data common block.
  1256. *
  1257. ****************************************************************************
  1258.       INCLUDE MACXRF.COM
  1259.  
  1260. ****************************************************************************
  1261. *
  1262. * Executable Code
  1263. *
  1264. ****************************************************************************
  1265. * Initialize the variable symbol table length.
  1266.       TABLELENGTH=TOTALSYMBOLS
  1267.  
  1268. * Repeat the sorting process until all elements have been adjusted.
  1269.       DO (TOTALSYMBOLS TIMES)
  1270.  
  1271. * Adjust the current symbol table length to reduce the number of entry tests.
  1272.     TABLELENGTH=TABLELENGTH-1
  1273.  
  1274. * Initialize the index to the current symbol table item.
  1275.         CURRENT=0
  1276.  
  1277. * Repeat the testing process until the current symbol table length is reached.
  1278.     DO (TABLELENGTH TIMES)
  1279.  
  1280. * Point to the next pair of symbol table entries.
  1281.       CURRENT=CURRENT+1
  1282.       NEXT=CURRENT+1
  1283.  
  1284. * Get the pointers into the symbol table for the current and next indices.
  1285.       CURIDX = SYMIDX(CURRENT)
  1286.       NXTIDX = SYMIDX(NEXT)
  1287.  
  1288. * If a swap is necessary...
  1289.       IF(SYMFIL(CURIDX) > SYMFIL(NXTIDX)) THEN
  1290. * ... then, swap the symbol table array indices.
  1291.         SYMIDX(NEXT) = CURIDX
  1292.         SYMIDX(CURRENT) = NXTIDX
  1293.       ENDIF
  1294.     REPEAT
  1295.       REPEAT
  1296.  
  1297.       RETURN
  1298.  
  1299.       END
  1300.  
  1301. *************************************************************************
  1302. * Title: FORTRAN Subprogram Cross-Referencer - Nesting Level Header
  1303. *
  1304. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1305. *
  1306. * Purpose: To write a header for the nesting level of the calling
  1307. *         structure.
  1308. *            
  1309. * Notes:   This routine writes the nesting level header to the screen and
  1310. *         if OUTPUTLVL is true, the header is saved in a file.
  1311. *    
  1312. * Warnings/Limitations: NONE
  1313. *      
  1314. * Calling Conventions: 
  1315. *    CALL LVLHDR
  1316. *
  1317. * Variables referenced in MACXRF.COM:
  1318. *    OUTPUTLVL    - Save calling structure flag.        (Logical*4)
  1319. *    SYMFLG       - Utilize symbol table flag.        (Logical*4)
  1320. *
  1321. * Modification History:
  1322. *
  1323. *************************************************************************
  1324.       SUBROUTINE LVLHDR
  1325.       IMPLICIT NONE
  1326. ****************************************************************************
  1327. *
  1328. * Constant Definition
  1329. *
  1330. ****************************************************************************
  1331.       INCLUDE MACXRF.PAR
  1332.  
  1333. ****************************************************************************
  1334. *
  1335. * Common Storage Definition
  1336. *
  1337. ****************************************************************************
  1338.       INCLUDE MACXRF.COM
  1339.  
  1340. ****************************************************************************
  1341. *
  1342. * Executable Code
  1343. *
  1344. ****************************************************************************
  1345. * Write the appropriate header depending on the symbol table usage.
  1346.       IF (SYMFLG) THEN
  1347.     WRITE (CONSOLE,10)
  1348.     IF (OUTPUTLVL) WRITE (LEVEL,10)
  1349.       ELSE
  1350.     WRITE (CONSOLE,20)
  1351.     IF (OUTPUTLVL) WRITE (LEVEL,20)
  1352.       ENDIF
  1353.  
  1354. 10    FORMAT ('A F    Called Programs',/,'- -    ---------------')
  1355. 20    FORMAT ('F    Called Programs',/,'-    ---------------')
  1356.  
  1357.       RETURN
  1358.       END
  1359.  
  1360. *************************************************************************
  1361. * Title: FORTRAN Subprogram Cross-Referencer - Symbol Table Header
  1362. *
  1363. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1364. *
  1365. * Purpose: To write the symbol table header to the symbol table file, if
  1366. *         one was requested.
  1367. *            
  1368. * Notes:   NONE
  1369. *    
  1370. * Warnings/Limitations: NONE
  1371. *      
  1372. * Calling Conventions:
  1373. *    CALL SMBHDR
  1374. *
  1375. * Variables referenced in MACXRF.COM:
  1376. *    SYMFLG       - Utilize symbol table flag.        (Logical*4)
  1377. *
  1378. * Modification History:  
  1379. *************************************************************************
  1380.       SUBROUTINE SMBHDR
  1381.       IMPLICIT NONE
  1382. ****************************************************************************
  1383. *
  1384. * Constant Definition
  1385. *
  1386. ****************************************************************************
  1387.       INCLUDE MACXRF.PAR
  1388.  
  1389. ****************************************************************************
  1390. *
  1391. * Global data common block.
  1392. *
  1393. ****************************************************************************
  1394.       INCLUDE MACXRF.COM
  1395.  
  1396. ****************************************************************************
  1397. *
  1398. * Executable Code
  1399. *
  1400. ****************************************************************************
  1401. * Write the appropriate header depending on the symbol table usage.
  1402.       IF (SYMFLG) THEN
  1403.         WRITE(SYMBOL,10)
  1404.       ELSE
  1405.         WRITE(SYMBOL,20)
  1406.       ENDIF
  1407.  
  1408. 10    FORMAT ('   File      Size of',/,
  1409.      +        '   Name    Object Code',/,
  1410.      +        '   ----    -----------')
  1411. 20    FORMAT ('   File      Size of     Number',/,
  1412.      +        '   Name    Object Code  of Calls',/,
  1413.      +        '   ----    -----------  --------')
  1414.  
  1415.       RETURN
  1416.       END
  1417.  
  1418. *************************************************************************
  1419. * Title: FORTRAN Subprogram Cross-Referencer - Reference Table Header
  1420. *
  1421. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1422. *
  1423. * Purpose: To write the reference table header to the reference table file,
  1424. *         if one was requested.
  1425. *            
  1426. * Notes:   NONE
  1427. *    
  1428. * Warnings/Limitations: NONE
  1429. *      
  1430. * Calling Conventions:
  1431. *    CALL REFHDR
  1432. *
  1433. * Variables referenced in MACXRF.COM:
  1434. *    OUTPUTREF    - Save reference table flag.        (Logical*4)
  1435. *
  1436. * Modification History:  
  1437. *************************************************************************
  1438.       SUBROUTINE REFHDR
  1439.       IMPLICIT NONE
  1440. ****************************************************************************
  1441. *
  1442. * Constant Definition
  1443. *
  1444. ****************************************************************************
  1445.       INCLUDE MACXRF.PAR
  1446.  
  1447. ****************************************************************************
  1448. *
  1449. * Global data common block.
  1450. *
  1451. ****************************************************************************
  1452.       INCLUDE MACXRF.COM
  1453.  
  1454. ****************************************************************************
  1455. *
  1456. * Executable Code
  1457. *
  1458. ****************************************************************************
  1459.       WRITE(REFERENCE,10)
  1460.  
  1461. 10    FORMAT ('Called          Calling',/,
  1462.      +        '------          -------')
  1463.  
  1464.       RETURN
  1465.       END
  1466.  
  1467. *************************************************************************
  1468. * Title: FORTRAN Subprogram Cross-Referencer - Subprogram search routine
  1469. *
  1470. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1471. *
  1472. * Purpose: To find all internal subroutines and functions in a FORTRAN
  1473. *         FORTRAN program and make them external by writing the to a
  1474. *         file with the extension ".ISR".
  1475. *            
  1476. * Notes:   This routine finds all internal subroutines and functions in the
  1477. *         active file and copies them into an external file with the
  1478. *         extension ".ISR".  This is accomplished by searching the
  1479. *         source code for a subroutine or function definition statement.
  1480. *         Once found, the file pointer is backed up to the point where
  1481. *         the previous routine was terminated (this causes all leading
  1482. *         comments to be included in the new file) and the source is
  1483. *         copied into the new file.
  1484. *    
  1485. * Warnings/Limitations: NONE
  1486. *      
  1487. * Calling Conventions:  
  1488. *       CALL FNDISR
  1489. *
  1490. * Variables referenced in MACXRF.COM:
  1491. *    INLINE       - A single source code line.        (Char*132)
  1492. *    PROGNM       - Active program name.            (Char*6)
  1493. *    CURRENTUNIT  - Current input file unit number.        (Integer*4)
  1494. *
  1495. * Modification History:  
  1496. *************************************************************************
  1497.       SUBROUTINE FNDISR
  1498.       IMPLICIT NONE
  1499. ****************************************************************************
  1500. *
  1501. * Local Variable and Function Declarations
  1502. *
  1503. ****************************************************************************
  1504. * Storage for the internal subroutine name.
  1505.       CHARACTER*6 ISRFIL
  1506.  
  1507. * Index value used in defining ISRFIL.
  1508.       INTEGER ISRIDX
  1509.  
  1510. * Source code line counter for leading comment retrieval.
  1511.       INTEGER NEWLINECOUNT
  1512.  
  1513. * Indicates an end was found, and the ensuing lines are for another file.
  1514.       LOGICAL NEWROUTINE
  1515.  
  1516. * Temporary string used in reference table output.
  1517.       CHARACTER*11 TMPSTR
  1518.  
  1519. * Index/Counter Variable.
  1520.       INTEGER ICNT
  1521.  
  1522. * Functions to look for a subroutine or a function.
  1523.       LOGICAL ISSUB
  1524.       LOGICAL ISFNC
  1525.  
  1526. * Function to convert a character string to all upper case.
  1527.       CHARACTER*132 UCS
  1528.  
  1529. * Function to strip the leading blanks and tabs from a string.
  1530.       CHARACTER*132 BYPASS
  1531.  
  1532. * Function to indicate that the given string is a FORTRAN end statement.
  1533.       LOGICAL ENDONLY
  1534.  
  1535. ****************************************************************************
  1536. *
  1537. * File Parameter Block Definition
  1538. *
  1539. ****************************************************************************
  1540.       INCLUDE PARAMS.INC
  1541.  
  1542. ****************************************************************************
  1543. *
  1544. * Macintosh ROM Trap Definition
  1545. *
  1546. ****************************************************************************
  1547.       INCLUDE TOOLBX.PAR
  1548.       INTEGER TOOLBX
  1549.  
  1550. ****************************************************************************
  1551. *
  1552. * Constant Definition
  1553. *
  1554. ****************************************************************************
  1555.       INCLUDE MACXRF.PAR
  1556.  
  1557. ****************************************************************************
  1558. *
  1559. * Common Storage Definition
  1560. *
  1561. ****************************************************************************
  1562.       INCLUDE MACXRF.COM
  1563.  
  1564. ****************************************************************************
  1565. *
  1566. * Executable Code
  1567. *
  1568. ****************************************************************************
  1569. * Initialize the file parameter block.
  1570.       DO (ICNT=1,80)
  1571.         params(ICNT) = 0
  1572.       REPEAT
  1573.  
  1574. * and the pointer to the file name.
  1575.       ionameptr = TOOLBX (PTR,TMPSTR)
  1576.  
  1577.       NEWLINECOUNT=0
  1578.       NEWROUTINE=.FALSE.
  1579.       DO
  1580.     READ (CURRENTUNIT,20,END=10) INLINE
  1581.  
  1582. * If an end was found and the next routine descriptor has not been, count
  1583. *   the number of lines read so they can be output later.
  1584.     IF (NEWROUTINE) THEN
  1585.       NEWLINECOUNT=NEWLINECOUNT+1
  1586.     ENDIF
  1587.  
  1588. * If the line is not a comment or blank, process it.
  1589.     IF (.NOT. ((INLINE(1:1) = 'C') .OR.
  1590.      +             (INLINE(1:1) = '*') .OR.
  1591.      +             (INLINE(1:1) = '!') .OR.
  1592.      +             (INLINE      = ' '))) THEN
  1593.       INLINE = UCS (BYPASS(INLINE(7:)))
  1594.  
  1595. * If an END is found, indicate that a new routine is being processed.
  1596.       NEWROUTINE=ENDONLY(INLINE)
  1597.  
  1598. * If a new routine is identified...
  1599.       IF (ISSUB() .OR. ISFNC()) THEN
  1600.  
  1601. * ...then, parse out the routine's name.
  1602.         ISRFIL = INLINE(1:6)
  1603.         ISRIDX = INDEX(ISRFIL,'(')
  1604.             IF (ISRIDX > 0) ISRFIL = ISRFIL(1:(ISRIDX-1))
  1605.  
  1606. * If this routine definition is not that of the currently active routine...
  1607.         IF (ISRFIL <> PROGNM) THEN
  1608.  
  1609. * ...then, back up and get any leading comments.
  1610.           DO (NEWLINECOUNT TIMES)
  1611.             BACKSPACE (CURRENTUNIT)
  1612.           REPEAT
  1613.           NEWLINECOUNT=0
  1614.  
  1615. * Open the file where the internal routine will be stored.
  1616.           OPEN (UNIT=ISRUNIT,FILE=TRIM(ISRFIL)//'.ISR',STATUS='NEW')
  1617.  
  1618.           TMPSTR = CHAR(LEN(TRIM(ISRFIL))+4)//TRIM(ISRFIL)//'.ISR'
  1619.           ICNT = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
  1620.           fdtype = 'TEXT'
  1621.           fdcreator = 'EDIT'
  1622.           ICNT = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))
  1623.  
  1624. * Process each line until the routine's end is found.
  1625.           DO
  1626.         READ (CURRENTUNIT,20) INLINE
  1627.         IF(INLINE = ' ') THEN
  1628.           WRITE (ISRUNIT,*)
  1629.         ELSE
  1630.           WRITE (ISRUNIT,*) TRIM(INLINE)
  1631.           IF (ENDONLY(UCS(BYPASS(INLINE(7:))))) THEN
  1632.             NEWROUTINE=.TRUE.
  1633.             EXIT
  1634.           ENDIF
  1635.         ENDIF
  1636.           REPEAT
  1637.  
  1638. * Close the external file.
  1639.           CLOSE (UNIT=ISRUNIT)
  1640.         ENDIF
  1641.       ENDIF
  1642.     ENDIF
  1643.       REPEAT
  1644.  
  1645. * Reset the currently active file for the cross-reference traversal.
  1646.   10  REWIND (CURRENTUNIT)
  1647.   20  FORMAT(A132)
  1648.  
  1649.       RETURN
  1650.  
  1651.       END
  1652.  
  1653. *************************************************************************
  1654. * Title: FORTRAN Subprogram Cross-Referencer - END statement indentifier
  1655. *
  1656. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1657. *
  1658. * Purpose: To recognize the end of a FORTRAN program.
  1659. *            
  1660. * Notes:   This logical function will differentiate between the several
  1661. *         catagories of end statements in FORTRAN to locate the final
  1662. *         END statement in the current routine.
  1663. *    
  1664. * Warnings/Limitations:
  1665. *       Trailing comments will cause this test to fail.
  1666. *      
  1667. * Calling Conventions: 
  1668. *       FLAG = ENDONLY(STRING)
  1669. *
  1670. * Calling Parameters:  
  1671. *    Unmodified: STRING - The string (of any length) to be tested.
  1672. *    Modified:   NONE
  1673. *    Returned:   NONE
  1674. *
  1675. * Variables referenced in MACXRF.COM:
  1676. *    NONE
  1677. *
  1678. * Modification History:
  1679. *
  1680. *************************************************************************
  1681.       LOGICAL FUNCTION ENDONLY (STRING)
  1682.       IMPLICIT NONE
  1683. ****************************************************************************
  1684. *
  1685. * Subroutine Parameter and Local Variable Declaration
  1686. *
  1687. ****************************************************************************
  1688. * Character string to be tested for an END statement.
  1689.       CHARACTER*(*) STRING
  1690.  
  1691. * String index that references the substring "END".
  1692.       INTEGER ENDIDX
  1693.  
  1694. ****************************************************************************
  1695. *
  1696. * Executable Code
  1697. *
  1698. ****************************************************************************
  1699.       ENDIDX=INDEX(STRING,'END')
  1700.  
  1701. * If there is no "END", then quit.
  1702.       IF (ENDIDX = 0) THEN
  1703.     ENDONLY=.FALSE.
  1704.         RETURN
  1705.       ENDIF
  1706.  
  1707. * If "END" starts at the first character position...
  1708.       IF (ENDIDX = 1) THEN
  1709.  
  1710. * ...then, see if the rest of the string is blank.
  1711.     ENDONLY = (STRING((ENDIDX+3):) = ' ')
  1712.       ELSE
  1713. * ...otherwise, see if the string before and after "END" is blank.
  1714.     ENDONLY = ((STRING(1:(ENDIDX-1)) //
  1715.      +              STRING((ENDIDX+3):)) = ' ')
  1716.       ENDIF
  1717.       RETURN
  1718.       END
  1719.  
  1720. *************************************************************************
  1721. * Title: FORTRAN Subprogram Cross-Referencer - Leading blank strip.
  1722. *
  1723. * Prouduced by: Absoft South, Inc.            Date:  1/14/85
  1724. *
  1725. * Purpose: Character function that strips the leading blanks from the
  1726. *            character string.
  1727. *
  1728. * Notes:   This routine can be used with any sized string that is legal
  1729. *         within this compiler.  All leading whitespace (ie - blanks
  1730. *         or tabs) are stripped from the front of the string, leaving
  1731. *         if left justified.
  1732. *
  1733. * Warnings/Limitations: 
  1734. *   
  1735. * Calling Conventions: 
  1736. *       DST = BYPASS (SRC)
  1737. *
  1738. * Calling Parameters:
  1739. *    Unmodified: SRC    - Source string to be fixed.
  1740. *    Modified:   NONE
  1741. *    Returned:   NONE
  1742. *
  1743. * Variables referenced in MACXRF.COM:
  1744. *    NONE
  1745. *
  1746. * Modification History:
  1747. *
  1748. *************************************************************************
  1749.       CHARACTER*(*) FUNCTION BYPASS (SRC)
  1750.       IMPLICIT NONE
  1751. ****************************************************************************
  1752. *
  1753. * Subroutine Parameter and Local Storage Declaration
  1754. *
  1755. ****************************************************************************
  1756. * Source string to be modified.
  1757.       CHARACTER*(*) SRC
  1758.  
  1759. * Character index value.
  1760.       INTEGER I
  1761.  
  1762. ****************************************************************************
  1763. *
  1764. * Executable Code
  1765. *
  1766. ****************************************************************************
  1767.       IF (SRC = ' ') RETURN
  1768.       BYPASS = SRC
  1769.       DO (I=1,LEN(BYPASS))
  1770.         IF (.NOT. ((BYPASS(I:I) = " ") .OR.
  1771.      +             (BYPASS(I:I) = CHAR(9)))) EXIT
  1772.       REPEAT
  1773.       BYPASS = BYPASS(I:)
  1774.       RETURN
  1775.       END
  1776.  
  1777. *************************************************************************
  1778. * Title: FORTRAN Subprogram Cross-Referencer - Upper case conversion.
  1779. *
  1780. * Produced by: Absoft South, Inc.             Date:  1/14/85
  1781. *
  1782. * Purpose: This FORTRAN function performs a conversion of all lower
  1783. *         case characters within a given string to upper case.
  1784. *
  1785. * Notes:   As with the BYPASS function, this will handle any legal string
  1786. *         legal string length.
  1787. *
  1788. * Warnings/Limitations: NONE
  1789. *
  1790. * Calling Conventions:
  1791. *       UPSTR = UCS (STRING)
  1792. *
  1793. * Calling Parameters:
  1794. *    Unmodified: STRING - The string to convert to upper case. (CHAR*132)
  1795. *    Modified:   NONE
  1796. *    Returned:   NONE
  1797. *
  1798. * Variables referenced in MACXRF.COM:
  1799. *    NONE
  1800. *
  1801. * Modification History:
  1802. *
  1803. *************************************************************************
  1804.       CHARACTER*(*) FUNCTION UCS(STRING)
  1805.       IMPLICIT NONE
  1806. *************************************************************************
  1807. *
  1808. * Variable declarations.
  1809. *
  1810. *************************************************************************
  1811. * Character string to be converted.
  1812.       CHARACTER STRING*(*)
  1813.  
  1814. * Character string index value.
  1815.       INTEGER I
  1816.  
  1817. ****************************************************************************
  1818. *
  1819. * Executable Code
  1820. *
  1821. ****************************************************************************
  1822. * Initialize the function value.
  1823.       UCS = STRING
  1824.  
  1825.       DO (I=1,LEN(UCS))
  1826.         IF (UCS(I:I) >= "a" .AND. UCS(I:I) <= "z")
  1827.      +      UCS(I:I) = CHAR(ICHAR(UCS(I:I)) - 32)
  1828.       REPEAT
  1829.       RETURN
  1830.       END
  1831.  
  1832. *************************************************************************
  1833. * Title: FORTRAN Subprogram Cross-Referencer - CALL Identifier
  1834. *
  1835. * Produced by: Absoft South, Inc.             Date: 1/15/85
  1836. *
  1837. * Purpose: To scan the current line for a CALL statement.
  1838. *            
  1839. * Notes:   This routine finds a call statement and parses out the called
  1840. *         program's name.  From this, the extension and file type are
  1841. *         determined.
  1842. *    
  1843. * Warnings/Limitations: NONE
  1844. *
  1845. * Calling Conventions: 
  1846. *       FLAG = ISCALL()
  1847. *
  1848. * Variables referenced in MACXRF.COM:
  1849. *    INLINE       - A single source code line.        (Char*132)
  1850. *    PROGNM       - Active program name.            (Char*6)
  1851. *    EXTN         - Active program extension.        (Char*4)
  1852. *    FILTYP       - File extension type (I, F, M, or ?).    (Char*1)
  1853. *
  1854. * Modification History:  
  1855. *
  1856. *************************************************************************
  1857.       LOGICAL FUNCTION ISCALL
  1858.       IMPLICIT NONE
  1859. ****************************************************************************
  1860. *
  1861. * Local Variable and Function Declarations
  1862. *
  1863. ****************************************************************************
  1864. * A single source code line.
  1865.       CHARACTER*1 FIRSTCHAR
  1866.  
  1867. * String index used in locating substrings.
  1868.       INTEGER LINIDX
  1869.  
  1870. * Indicates the success or failure of an INQUIRE statement.
  1871.       LOGICAL FOUND
  1872.  
  1873. * Function to strip the leading blanks and tabs from a string.
  1874.       CHARACTER*132 BYPASS
  1875.  
  1876. ****************************************************************************
  1877. *
  1878. * Common Storage Definition
  1879. *
  1880. ****************************************************************************
  1881.       INCLUDE MACXRF.COM
  1882.  
  1883. ****************************************************************************
  1884. *
  1885. * Executable Code
  1886. *
  1887. ****************************************************************************
  1888. * Initialize the function result.
  1889.       ISCALL=.FALSE.
  1890.  
  1891. * Look for the CALL substring.
  1892.       LINIDX = INDEX (INLINE,'CALL')
  1893.  
  1894. * If this substring exists in the input line...
  1895.       IF (LINIDX > 0) THEN
  1896.  
  1897. * ...then, try to determine who is being called.
  1898.     INLINE = INLINE((LINIDX+4):)
  1899.     FIRSTCHAR=INLINE(1:1)
  1900.  
  1901. * If the first character is a space of tab...
  1902.     IF ((FIRSTCHAR = ' ') .OR.
  1903.      +        (FIRSTCHAR = CHAR(9))) THEN
  1904.       INLINE=BYPASS(INLINE)
  1905.       FIRSTCHAR=INLINE(1:1)
  1906.  
  1907. * ...and the next printable character is alphabetic...
  1908.       IF (((FIRSTCHAR>'@') .AND. (FIRSTCHAR<'[')) .OR.
  1909.      +          ((FIRSTCHAR>'`') .AND. (FIRSTCHAR<'{'))) THEN
  1910.  
  1911. * ...then, it is a CALL statement.
  1912.         ISCALL=.TRUE.
  1913.         PROGNM=INLINE(1:6)
  1914.         LINIDX = INDEX (PROGNM,'(') - 1
  1915.         IF (LINIDX > 0) PROGNM=PROGNM(1:LINIDX)
  1916.  
  1917. ************************************************************************ 
  1918. *
  1919. * Determine the extension of the source code to the file being called.
  1920. *                                                                        
  1921. ************************************************************************ 
  1922. * Internal subroutine (".ISR")
  1923.         EXTN='.ISR'
  1924.         INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
  1925.         IF (.NOT. FOUND) THEN
  1926.  
  1927. * FORTRAN subroutine (".FOR")
  1928.           EXTN='.FOR'
  1929.           INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
  1930.           IF (.NOT. FOUND) THEN
  1931.  
  1932. * Assembly subroutine (".M68")
  1933.         EXTN='.M68'
  1934.         INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
  1935.         IF (.NOT. FOUND) THEN
  1936.  
  1937. * No match found (".???")
  1938.           EXTN='.???'
  1939.           ENDIF
  1940.           ENDIF
  1941.         ENDIF
  1942.  
  1943. * Assign a value to the file type now that it is known.
  1944.         FILTYP = EXTN(2:2)
  1945.       ENDIF
  1946.     ENDIF
  1947.       ENDIF
  1948.  
  1949.       RETURN
  1950.       END
  1951.  
  1952. *************************************************************************
  1953. * Title: FORTRAN Subprogram Cross-Referencer - Subroutine identifier
  1954. *
  1955. * Produced by: Absoft South, Inc.             Date:  1/15/85
  1956. *
  1957. * Purpose: To determine if the given source code line is a subroutine
  1958. *         definition line.
  1959. *            
  1960. * Notes:   This routine assumes that if the first word on the line is
  1961. *         SUBROUTINE, then the line is a subroutine definition.  It
  1962. *         is not case sensitive since the input line is always
  1963. *         converted to upper case.  Also, comments are not processed.
  1964. *    
  1965. * Warnings/Limitations: 
  1966. *      
  1967. * Calling Conventions: 
  1968. *       FLAG = ISSUB ()
  1969. *
  1970. * Variables referenced in MACXRF.COM:
  1971. *    INLINE       - A single source code line.        (Char*132)
  1972. *
  1973. * Modification History:
  1974. *
  1975. *************************************************************************
  1976.       LOGICAL FUNCTION ISSUB ()
  1977.       IMPLICIT NONE
  1978. ****************************************************************************
  1979. *
  1980. * Local Variable and Function Declarations
  1981. *
  1982. ****************************************************************************
  1983. * Function to strip the leading blanks and tabs from a string.
  1984.       CHARACTER*132 BYPASS
  1985.  
  1986. ****************************************************************************
  1987. *
  1988. * Common Storage Definition
  1989. *
  1990. ****************************************************************************
  1991.       INCLUDE MACXRF.COM
  1992.  
  1993. ****************************************************************************
  1994. *
  1995. * Executable Code
  1996. *
  1997. ****************************************************************************
  1998. * If the first word is SUBROUTINE...
  1999.       IF (INLINE(1:10) = 'SUBROUTINE') THEN
  2000.  
  2001. * ...then, redefine the line to start at the subroutine's name.
  2002.     INLINE = BYPASS(INLINE(11:))
  2003.     ISSUB = .TRUE.
  2004.       ELSE
  2005.     ISSUB = .FALSE.
  2006.       ENDIF
  2007.  
  2008.       RETURN
  2009.       END
  2010.  
  2011. *************************************************************************
  2012. * Title: FORTRAN Subprogram Cross-Referencer - Function identifier
  2013. *
  2014. * Produced by: Absoft South, Inc.             Date:  1/15/85
  2015. *
  2016. * Purpose: To determine if the given source code line is a function
  2017. *         definition line.
  2018. *            
  2019. * Notes:   This routine assumes that if the word FUNCTION is found in
  2020. *         the input line, the line is a function definition statement.
  2021. *         Since comments are ignored, the word function may appear
  2022. *         in one of the full line comments.
  2023. *    
  2024. * Warnings/Limitations: 
  2025. *      
  2026. * Calling Conventions: 
  2027. *       FLAG = ISFNC ()
  2028. *
  2029. * Variables referenced in MACXRF.COM:
  2030. *    INLINE       - A single source code line.        (Char*132)
  2031. *
  2032. * Modification History:
  2033. *
  2034. *************************************************************************
  2035.       LOGICAL FUNCTION ISFNC ()
  2036.       IMPLICIT NONE
  2037. ****************************************************************************
  2038. *
  2039. * Local Variable and Function Declarations
  2040. *
  2041. ****************************************************************************
  2042. * String index used in locating substrings.
  2043.       INTEGER LINIDX
  2044.  
  2045. * Function to strip the leading blanks and tabs from a string.
  2046.       CHARACTER*132 BYPASS
  2047.  
  2048. ****************************************************************************
  2049. *
  2050. * Common Storage Definition
  2051. *
  2052. ****************************************************************************
  2053.       INCLUDE MACXRF.COM
  2054.  
  2055. ****************************************************************************
  2056. *
  2057. * Executable Code
  2058. *
  2059. ****************************************************************************
  2060. * Look for the word "FUNCTION".
  2061.       LINIDX = INDEX (INLINE,'FUNCTION')
  2062.  
  2063. * If the word FUNCTION exists in the current line...
  2064.       IF (LINIDX > 1) THEN
  2065.  
  2066. * ...then, redefine the line to start at the function's name.
  2067.     INLINE = BYPASS(INLINE((LINIDX+8):))
  2068.     ISFNC = .TRUE.
  2069.       ELSE
  2070.     ISFNC = .FALSE.
  2071.       ENDIF
  2072.  
  2073.       RETURN
  2074.       END
  2075.  
  2076. * Use this dummy subroutine to force enough heap allocation for 15 open
  2077. *   files at once.
  2078.       SUBROUTINE DUMMY1
  2079.       INTEGER*4 SPACE(300,10)
  2080.       COMMON // SPACE
  2081.       RETURN
  2082.       END
  2083.